home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 008 / cadence.arc / VOL2NO2.ARC / MOMENT.LSP < prev    next >
Encoding:
Text File  |  1986-12-19  |  3.2 KB  |  82 lines
  1. ;This function calculates the centroid and the moment of inertia
  2. ;  for a profile.  The profile should be "selected" immediately
  3. ;  before invoking this routine.  The function creates creates a
  4. ;  layer named "Moment", creates a red point at the centroid
  5. ;  and then prints the x and y moment of inertia values.
  6. ;  The function averages exploded cross hatching to calculate the
  7. ;  centroid and integrates each points' delta from the centroid to
  8. ;  determine the moment.  (see Cadence Vol.1 No.3, pg 51)
  9. ;
  10. ;================================================================
  11. ; CHAZ HENRY      NORTH CAROLINA STATE UNIVERSITY, RALEIGH, NC
  12. ;================================================================
  13. ; 12-12-86        SIEMENS ENERGY AND AUTOMATION,   RALEIGH, NC
  14. ;================================================================
  15.  
  16. (defun moment ( / l xcord ycord temp momentx momenty cnt oldlay centroidx
  17.   centroiidy scale ss e scalesqterm cellsize)
  18.   (if (ssget "p")
  19.       (progn
  20.         (setq cnt 0  centroidx 0 centroidy 0 oldlay (getvar "CLAYER"))
  21.         (setq scale (* (getvar "VIEWSIZE") 0.4))
  22.         (command "LAYER" "m" "moment" "c" "red" "moment" "")
  23.         (command "HATCH" "*DOTS" scale "45" "p" "")
  24.         (command "LAYER" "off" "*" "n" "")
  25.         (setq ss (ssget "W" (getvar "LIMMAX") (getvar "LIMMIN")))
  26.  
  27.         (setq l (sslength ss))
  28.         (princ "calculating centroid.....")
  29.         (while (< cnt l)
  30.                (progn
  31.                  (setq e (entget (ssname ss cnt)))
  32.                  (setq centroidx (+ centroidx (car (cdr (assoc 10 e)))))
  33.                  (setq centroidy (+ centroidy (nth 2 (assoc 10 e))))
  34.                  (setq cnt (1+ cnt))))
  35.  
  36.         (setq centroidx (/ centroidx cnt)
  37.               centroidy (/ centroidy cnt))
  38.         (princ "done")
  39.         (terpri)
  40.  
  41.         (princ "calculating moment of inertia.....")
  42.  
  43.         (setq cnt 0
  44.               cellsize (* (/ scale 16) (/ scale 16))
  45.               momentx 0
  46.               momenty 0
  47.               cellsqterm (/ (* cellsize cellsize) 12))
  48.  
  49.         (while (< cnt l)
  50.                (progn
  51.                  (setq e (entget (ssname ss cnt)))
  52.                  (setq xcord (car (cdr (setq temp (assoc 10 e)))))
  53.                  (setq ycord (nth 2 temp))
  54.                  (setq momentx (+ momentx
  55.                                   cellsqterm
  56.                                   (* cellsize (* (setq temp (- centroidx xcord)) temp))))
  57.                  (setq momenty (+ momenty
  58.                                   cellsqterm
  59.                                   (* cellsize (* (setq temp (- centroidy ycord)) temp))))
  60.                  (setq cnt (1+ cnt))))
  61.  
  62.         (princ "done")
  63.         (terpri)
  64.  
  65.         ;erase construction points.
  66.         (command "ERASE" "w" (getvar "LIMMAX") (getvar "LIMMIN") "")
  67.         ;draw point at centroid
  68.         (command "POINT" (list centroidx  centroidy))
  69.         ;restore the original layer setting.
  70.         (command "LAYER" "s" oldlay "")
  71.         (terpri)
  72.         ;print x & y moments
  73.         (princ "X moment = ")(princ momentx)
  74.         (princ "    ")
  75.         (princ "Y moment = ")(princ momenty)
  76.         (terpri)
  77.         )
  78.        "No items preselected..select profile and retry")
  79.  
  80.   )
  81.  
  82.